Se presenta un analisis de la mortalidad por causas a nivel de departamentos que corresponden al nivel 3, o de Division Administrativa Menor (DAME). y se estima la pendiente.
data_mort <- readRDS("data_salidas/data_mortalidad_deptos.rds")
tabla_labels <- read.csv2("data_geo/lista_departamentos_codigos.csv")## Rows: 86,015
## Columns: 8
## $ gedad <ord> e70_, e70_, e70_, e70_, e70_, e70_, e70_, e70_, e70_, e70_, …
## $ sexo <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, …
## $ geocodigo <chr> "14154", "42091", "78042", "42063", "14154", "6770", "10014"…
## $ label <chr> "Sobremonte", "Limay Mahuida", "Magallanes", "Chical Co", "S…
## $ anio <dbl> 2003, 2003, 2003, 2003, 2009, 2003, 2003, 2003, 2003, 2003, …
## $ grupo_oms <chr> "notrans", "notrans", "notrans", "notrans", "notrans", "notr…
## $ casos <int> 75, 2, 71, 11, 63, 593, 28, 364, 92, 43, 60, 179, 177, 128, …
## $ pob <dbl> 140, 4, 153, 27, 157, 1508, 73, 960, 245, 116, 165, 494, 490…
# mutate(
# gedad = recode(
# gedad,
# "Menor de 24" = "e24_",
# "25 a 69" = "e25_",
# "70 y mas" = "e70_"
# ),
# sexo = recode(
# sexo,
# "Varón" = 1,
# "Mujer" = 2
# ),
# grupo_oms = recode(
# grupo_oms,
# "Condiciones transmisibles, maternas, perinatales y nutricionales" = "trans",
# "Enfermedades no transmisibles" = "notrans",
# "Enfermedades mal definidas" = "maldef",
# "Lesiones" = "lesi"
# )Para estimar la pendiente se requieren al menos 3 registros continuos para cada combinacion año-edad-grupo de causa.
var_agg <- c("anio", "geocodigo", "gedad", "grupo_oms")
data_mort |>
filter(!anio %in% c(2003, 2021)) |>
group_by_at(var_agg) |>
summarise(
casos = sum(casos),
pob = sum(pob),
rmxm = casos / pob * 100000
) |>
ungroup()-> data_mort_gral## `summarise()` has grouped output by 'anio', 'geocodigo', 'gedad'. You can
## override using the `.groups` argument.
## Rows: 30,720
## Columns: 7
## $ anio <dbl> 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, …
## $ geocodigo <chr> "10007", "10007", "10007", "10007", "10007", "10007", "10007…
## $ gedad <ord> e24_, e24_, e24_, e24_, e25_, e25_, e25_, e25_, e70_, e70_, …
## $ grupo_oms <chr> "lesi", "maldef", "notrans", "trans", "lesi", "maldef", "not…
## $ casos <int> 1, 1, 0, 3, 5, 2, 17, 2, 0, 3, 49, 5, 0, 0, 2, 0, 1, 3, 10, …
## $ pob <dbl> 1950, 1950, 1950, 1950, 2127, 2127, 2127, 2127, 338, 338, 33…
## $ rmxm <dbl> 51.28205, 51.28205, 0.00000, 153.84615, 235.07287, 94.02915,…
## Warning: Supplying `...` without names was deprecated in tidyr 1.0.0.
## ℹ Please specify a name for each selection.
## ℹ Did you want `data = c(-geocodigo, -gedad, -grupo_oms)`?
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
nested_data_mort |>
mutate(
mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
tidied = purrr::map(mktest, broom::tidy)
) |>
unnest(tidied)## # A tibble: 1 × 4
## geocodigo gedad grupo_oms data
## <chr> <ord> <chr> <list>
## 1 94028 e70_ lesi <tibble [5 × 4]>
nested_data_mort |>
mutate(
mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
tidied = purrr::map(mktest, broom::tidy)
) |>
unnest(tidied)nested_data_mort |>
mutate(
mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
tidied = purrr::map(mktest, broom::tidy)
) |>
unnest(tidied)nested_data_mort |>
mutate(
mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
tidied = purrr::map(mktest, broom::tidy)
) |>
unnest(tidied)nested_data_mort |>
mutate(
mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
tidied = purrr::map(mktest, broom::tidy)
) |>
unnest(tidied) |>
select(geocodigo, gedad, grupo_oms, statistic, p.value) |>
filter(p.value<=0.1)-> mann_kendall_deptos## Rows: 1,182
## Columns: 5
## $ geocodigo <chr> "10007", "10007", "10007", "10014", "10021", "10035", "10035…
## $ gedad <ord> e24_, e25_, e70_, e70_, e24_, e24_, e70_, e70_, e24_, e70_, …
## $ grupo_oms <chr> "lesi", "notrans", "trans", "notrans", "trans", "trans", "no…
## $ statistic <dbl> 2.204541, 2.204541, 2.204541, -1.714643, -2.204541, -1.71464…
## $ p.value <dbl> 0.02748634, 0.02748634, 0.02748634, 0.08641073, 0.02748634, …
mann_kendall_deptos |>
mutate(
pendiente = case_when(
statistic == 0 ~ "mantuvo",
statistic > 0 ~ "subio",
statistic < 0 ~ "bajo"
),
p.val= case_when(
p.value <= .05 ~ "_alt.sig",
p.value < .1 ~ "_sig",
p.value > .1 ~ "_no.sig"
),
mktest = paste(pendiente, p.val)
) |>
select(1:3, 8)->lista_pendientesdata_mort_gral |>
left_join(lista_pendientes, by=c("gedad", "grupo_oms", "geocodigo")) |>
mutate(
mktest = if_else(
is.na(mktest),
"no.stat.sig",
mktest
))->data_mort_gral_mktestdata_mort_gral_mktest |>
filter(anio == 2018) |>
distinct(geocodigo, gedad, pob) |>
group_by(geocodigo) |>
summarise(
pob = sum(pob)
) |>
mutate(
pob_size = case_when(
pob > 0 & pob < 5000 ~ "Menos de 5.000",
pob >= 5001 & pob < 10000 ~ "de 5.000 a 10.000",
pob >= 10001 & pob < 50000 ~ "de 10.000 a 50.000",
pob >= 50001 & pob < 250000 ~ "de 50.000 a 250.000",
pob >= 250001 & pob < 500000 ~ "de 250.000 a 500.000",
pob >= 500001 ~ "de 500.000 y mas"
),
pob_size = factor(pob_size, levels = c(
"Menos de 5.000",
"de 5.000 a 10.000",
"de 10.000 a 50.000",
"de 50.000 a 250.000",
"de 250.000 a 500.000",
"de 500.000 y mas"), ordered = TRUE)
)->tabla_size_pob# tasas relevantes
data_mort_gral_mktest |>
group_by_at(var_agg) |>
mutate(
ici_rmxm = round(qchisq(0.025, 2 * casos) / (2 * pob) * 100000,1), #intervalo inferior
ics_rmxm = round(qchisq(0.975, 2 * casos + 2) / (2 * pob) * 100000,1), # intervalo superior
pob_size = tabla_size_pob$pob_size[match(geocodigo, tabla_size_pob$geocodigo)]
) |>
ungroup()->data_mort_gral_mktest## # A tibble: 6 × 11
## anio geocodigo gedad grupo_oms casos pob rmxm mktest ici_rmxm ics_rmxm
## <dbl> <chr> <ord> <chr> <int> <dbl> <dbl> <chr> <dbl> <dbl>
## 1 2006 10007 e24_ lesi 1 1950 51.3 subio _al… 1.3 286.
## 2 2006 10007 e24_ maldef 1 1950 51.3 no.stat.s… 1.3 286.
## 3 2006 10007 e24_ notrans 0 1950 0 no.stat.s… 0 189.
## 4 2006 10007 e24_ trans 3 1950 154. no.stat.s… 31.7 450.
## 5 2006 10007 e25_ lesi 5 2127 235. no.stat.s… 76.3 549.
## 6 2006 10007 e25_ maldef 2 2127 94.0 no.stat.s… 11.4 340.
## # ℹ 1 more variable: pob_size <ord>
data_mort_gral_mktest |>
filter(mktest == "subio _alt.sig") |>
ggplot(aes(anio, rmxm, color=pob_size))+
geom_jitter(alpha=.3)+
stat_summary(fun.y=mean, geom = "smooth")+
facet_wrap(~gedad+grupo_oms, scales="free_y")+
theme(
legend.position = "bottom",
legend.text = element_text(size = 6),
legend.key.size = unit(.5, "cm"),
axis.text.x = element_text(size=8)
)+
guides(colour = guide_legend(ncol=6))+
labs(
color=""
)## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
plotly::ggplotly(
data_mort_gral_mktest |>
filter(gedad=="e70_", mktest=="subio _alt.sig", grupo_oms=="trans") |>
mutate(label= tabla_labels$dame[match(geocodigo, tabla_labels$SearchGeoCode)]) |>
ggplot(aes(x=anio, label=label))+
geom_line(aes(y=rmxm, colour = geocodigo))+
geom_ribbon(aes(ymin = ici_rmxm, ymax = ics_rmxm, fill = geocodigo), alpha=.2)+
facet_wrap(~pob_size)+
theme(
legend.position = "none",
legend.key = element_blank()
)+
guides(
color=guide_legend(label=FALSE),
fill=guide_legend(label=FALSE)
)
)Se importan los datos geograficos.
data_mort_mktest_map <- data_mort_gral_pend |>
merge(geo_depto, by.x = "geocodigo", by.y = "DEPTO_LINK")
data_mort_mktest_map <- st_as_sf(data_mort_mktest_map)## [1] "no.stat.sig" "subio _alt.sig" "bajo _sig" "bajo _alt.sig"
## [5] "subio _sig"
ggplot()+
geom_sf(data = data_mort_mktest_map, aes(fill=mktest), color=NA, lwd = 0)+
scale_fill_manual(values =c("#218A86","#BECDAB","#F5F5F5", "#EEC392","#D06539"),
labels= c("bajo _alt.sig", " bajo _sig " ," no.stat.sig ", " subio _sig ", "subio _alt.sig")
)+
geom_sf(data = geo_prov, fill=NA, lwd=.1, color="gray9")+
facet_grid(gedad~grupo_oms, switch = "y", labeller = label_wrap_gen(multi_line = TRUE))+
theme_void()+
theme(
strip.text.x = element_text(size=6, colour = "grey40", margin = margin(r = .5, unit= "cm")),
strip.text.y = element_text(angle = 0, size=6.5, colour = "grey40"),
plot.title = element_text(hjust = .5, size = 10, color="grey30", face = "bold", margin = margin(t = .5, b = .01, unit = "cm")),
plot.subtitle = element_text(hjust = 0.5, size=10,color="grey30", face = "bold", margin = margin(b = .5, unit = "cm")),
legend.position = "bottom",
legend.title.position = "top",
legend.direction = "horizontal",
legend.box.just = "center",
legend.text.position = "bottom",
legend.text = element_text(hjust = 1, size=6, colour = "grey40"),
legend.key = element_rect(linewidth = .05),
legend.key.size = unit(.4, "cm"),
legend.key.spacing = unit(.05, "cm"),
panel.spacing.x = unit(.5, "cm")
)+
labs(
title = "Estimacion de pendiente evolucion mortalidad por causas (2005-2007 a 2017-2019)",
subtitle = "segun grupos de edad y causa, provincias argentinas",
fill = "Mann-Kendall test",
caption = "Se estima de la pendiente +/- 0, p.value < 0.1 | p.value < 0.05"
)->mapa1## Saving 7 x 5 in image